perm filename JFILL.F4[MSS,LCS] blob sn#132695 filedate 1974-11-21 generic text, type T, neo UTF8
00100	****** FILLER, HGHT, MISS, HALF ********
00200	C  Q AND R  ARE X,Y COORDS.  NE(1)=WDCNT. OTHER NE'S HAVE 3
00300	C   FOR INVIS. VECTORS.   M=VERTICAL SCAN LINES
00400		SUBROUTINE FILLER(Q,R,NE,M)
00500		DIMENSION Q(1),R(1),NE(1)
00600	CC	M1=M+1
00700		KK=NE(1)
00800	CC	LA=0
00900		KJ=2
01000		DO 4 K=2,KK
01100		IF(NE(K).NE.3)GO TO 11
01200	CCCC	NE(K)=KJ
01300		NE(K)=-1
01400		KJ=K+1
01500		GO TO 4
01600	11	NE(K)=0
01700	4	CONTINUE
01800		RLFT=10000
01900		RT=-10000
02000		B=RT
02100		DO 12 K=1,KK
02200		H=IFIX(Q(K))
02300		IF(H.LT.RLFT)RLFT=H
02400	C  FINDS LEFT AND RIGHT LIMITS.
02500		IF(H.GT.RT)RT=H
02600		IF(H.EQ.B)NE(K)=-1
02700	C FINDS VERTICAL LINES.
02800		B=H
02900		Q(K)=H
03000	12	R(K)=IFIX(R(K))
03100	CCCC	NE(KK+1)=KJ
03200		NE(KK+1)=-1
03300	C  FINDS JUMPS
03400		LRT=RT
03500		JA=3
03600	CC123	DO 41 K=2,KK
03700	CC41	IF(NE(K).EQ.0)GO TO 124
03800	CC	RETURN
03900	C  NO MORE LINES TO LOOK AT.
04000	
04100	124	LEFT=RLFT
04200	51	J=LEFT
04300	42	RJ=J+.001
04400		JCONT=0
04500	CC	JN=J
04600		LEFT=J
04700	
04800	C  NEXT LOOKS TO SEE IF 'ALT' IS HIGHEST AVAILABLE POINT.
04900		JJ=-1
05000		ALT=-10000.
05100	200	DO 45 L=2,KK
05200		IF(NE(L).NE.0)GO TO 45
05300	C  PASSES ANY LINE THAT HAS BEEN USED FOR ↑ OR ↓ SO FAR.
05400	C NE=-1 ↓;  =1 ↑;  
05500		IF(MISS(L,RJ,Q))GO TO 45
05600	C  FINDS HIGHEST UNUSED LINE UNDER J
05700		H=HGHT(L,RJ,Q,R)
05800		IF(H.LT.ALT)GO TO 45
05900		ALT=H
06000		JJ=L
06100	45	CONTINUE
06200		IF(JJ)GO TO 43
06300	C  DID NOT FIND A NEW LINE TO USE.
06400		JCONT=-1
06500		LEFT=J
06600	
06700	46	JA=3
06800		JORD=-1
06900	52	KN=Q(JJ)
07000		KL=Q(JJ-1)
07100		IF(KN.LT.KL)KN=KL
07200	50	I=J
07300	CC50	DO 49 I=J,KN-1,M
07400	102	RJ=I+.01
07500	CC	IF(I.EQ.KN)RJ=RJ-.002
07600		ALT=HGHT(JJ,RJ,Q,R)
07650	C  MAKE I,M,J,LEFT ETC. FLOATING PT.
07700	CC	LA=K
07800	C  NEXT FINDS HIGHEST POINT TO DRAW TO.
07900		B=-10000
08000		JK=-1
08100		XALT=ALT+.001
08110		ZALT=ALT
08200	400	DO 47 L=2,KK
08300		IF(L.EQ.JJ.OR.MISS(L,RJ,Q).OR.NE(L).LT.0)GO TO 47
08400		H=HGHT(L,RJ,Q,R)
08500		IF(H.GT.XALT)GO TO 47
08600		IF(H.LE.B)GO TO 47
08700		B=H
08800	C  FINDS HIGHEST POINT.
08900		JK=L
09000	47	CONTINUE
09100		IF(JK)GO TO 48
09150		ALT=ALT-1
09200	300	IF(ZALT-B.GT..001.OR.I.NE.J)GO TO 59
09300		JX=Q(JK)
09400		IF(JX.GT.KN)GO TO 60
09500		JX=Q(JK-1)
09600		IF(JX.LT.KN)GO TO 59
09700	60	L=JJ
09800		JJ=JK
09900		JK=L
10000		KN=JX
10100	C REVERSES ROLE OF LINES IF 2ND IS LONGER.
10110	59	B=B+1
10200		IF(JORD)GO TO 103
10300		H=B
10400		B=ALT
10500		ALT=H
10550		IF(JK.NE.NK.AND.ABS(ALT-B).GT.5.)JA=3
10600	103	CALL LINES(RJ,ALT,JA)
10700	100	CALL LINES(RJ,B,2)
10710		NK=JK
10720	C  FOR CHANGES AT END POINTS OF LINES.
10800		JORD=-JORD
10900	C JORD IS TO AVOID DIAGONAL LINES IN FILLER.
11000		NE(JK)=1
11100		NE(JJ)=-1
11200	CC101	CALL DPYOUT(1)
11300		JA=2
11400		I=I+M
11500		IF(I.LT.KN)GO TO 102
11600	
11700		L=1
11800		IF(KN.EQ.KL)L=-1
11900		JJ=JJ+L
12000		J=0
12100		IF(L)J=-1
12200	C  FIGURES OUT DIRECTION OF NEXT LINE SEG.
12300		IF(KN+M.GT.Q(JJ+J).OR.JJ.GT.KK.OR.NE(JJ).NE.0)GO TO 124
12400		J=I
12500	CC	J=I+M
12600		GO TO 52
12700	48	JA=3
12800	43	J=LEFT+M
12900	C  M IS SET IN FILLMS
13000		IF(J.LE.LRT)GO TO 42
13100		IF(JCONT)GO TO 51
13200	C  GOES BACK TO LOOK FOR MORE.
13300		END
13400	
13500		FUNCTION HGHT(J,A,Q,R)
13600		DIMENSION Q(1),R(1)
13700		B=R(J-1)
13800		D=Q(J-1)
13900		F=Q(J)
14000		HGHT=((R(J)-B)*(A-D))/(F-D)+B
14100		IF(F.EQ.D)HGHT=B
14200		END
14300	
14400		FUNCTION MISS(J,A,Q)
14500		DIMENSION Q(1)
14600		B=Q(J)
14700		C=Q(J-1)
14800		MISS=-1
14900		IF((A.LT.C.AND.A.GT.B).OR.(A.LT.B.AND.A.GT.C))MISS=0
15000		END
15100	C  MISS=-1, HIT=0
16000		SUBROUTINE UNPACK(M,N,I)
16100		COMMON/LL/L
16200	C  L IS FOR VIS. OR INVIS. LINES.
16300		N=I
16400		L=2
16500		M=N/100000000
16600		IF(M.EQ.0)GO TO 2
16700		L=3
16800		N=N-100000000*M
16900	2	M=N/10000
17000		N=MOD(N,10000)
17100		IF(M.GT.1000)M=1000-M
17200		IF(N.GT.1000)N=1000-N
17300		END
17400